home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib16.dsk / NIBBLE DINER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  38KB  |  554 lines
  1. 1  REM **********************
  2. 2  REM *    NIBBLE DINER    *
  3. 3  REM * BY D.R. PENDERGAST *
  4. 4  REM * COPYRIGHT (C) 1984 *
  5. 5  REM * BY MICROSPARC, INC *
  6. 6  REM * LINCOLN, MA. 01773 *
  7. 7  REM **********************
  8. 10  REM ** NIBBLE DINER **
  9. 20  POKE 768,0: POKE 769,0
  10. 30  REM **PLACE TITLE ON SCREEN**
  11. 40  TEXT : HOME : GOSUB 305
  12. 50  VTAB 3: HTAB 12: PRINT "D. R. PENDERGAST ": VTAB 4: HTAB 09: PRINT "22-6540 FALCONER DRIVE": VTAB 5: HTAB 7: PRINT "MISSISSAUGA, ONT., L5N 1M1 ": VTAB 7: HTAB 14: PRINT "416-826-5363": VTAB 20: HTAB 3: PRINT "COPYRIGHT 1984 BY MICROSPARC, INC."
  13. 60  VTAB 9: HTAB 13: PRINT "   PRESENTS    ": VTAB 12: HTAB 9: INVERSE : PRINT "**   NIBBLE  DINER   **": NORMAL : VTAB 15: HTAB 09: PRINT "MOTIVATIONAL  FEEDBACK": HTAB 11: PRINT "NUTRITION ANALYSIS": HTAB 17: PRINT "SYSTEM"
  14. 70  GOSUB 785: HOME :AA$ = "  NIBBLE  DINER  ":A1$ = "CAUTIONARY  NOTES": VTAB 6: HTAB 3: PRINT "SUGGESTIONS ON WEIGHT AND NUTRITION": VTAB 8: HTAB 3: PRINT "APPLY TO MEN AND WOMEN OF 25 YEARS": VTAB 10: HTAB 3: PRINT "TO 50 YEARS OF AGE."
  15. 80  VTAB 13: HTAB 3: PRINT "PREGNANT WOMEN ARE EXCLUDED. THEY": VTAB 15: HTAB 3: PRINT "AND OTHERS ARE ADVISED TO CONTACT": VTAB 17: HTAB 3: PRINT "A DOCTOR FOR ADDITIONAL INFORMATION": VTAB 19: HTAB 3: PRINT "AND ADVICE."
  16. 90  GOSUB 260: GOSUB 305: GOSUB 785
  17. 100  GOTO 1500
  18. 200  REM **SUBROUTINES BELOW**
  19. 205  REM **VERIFICATION**
  20. 210  VTAB 23: CALL  -868: PRINT "CORRECT (Y/N) ";G$;: GET Y$: PRINT Y$: RETURN 
  21. 215  REM **DATA ENTRY**
  22. 220  PRINT "ENTER ";: INVERSE :CV =  PEEK(37): GOSUB 225:P$(K) = Q$: RETURN 
  23. 225  PRINT T$(K);: NORMAL : PRINT ": ";G$: PRINT V1$; TAB( TV(K) +3);V2$: VTAB (CV +2): HTAB 2: INPUT Q$: VTAB (CV +1): HTAB ( LEN(T$(K)) +9): CALL  -958: PRINT Q$: RETURN 
  24. 230  REM **OPEN FILES TO WRITE**
  25. 235  PRINT D$"OPEN ";FILE$",L";RL;",S";SX;",D";DX
  26. 240  PRINT D$"WRITE";FILE$",R";RX
  27. 245  RETURN 
  28. 250  REM **QUIT INSTRUCTION**
  29. 255  PRINT "PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " TO QUIT ";: RETURN 
  30. 260  REM **CENTER LINE**
  31. 265  VTAB 2: HTAB (20 - LEN(AA$)/2): INVERSE : PRINT AA$: NORMAL 
  32. 270  VTAB 3: HTAB 2: PRINT B$: VTAB 3: INVERSE : HTAB (20 - LEN(A1$)/2): PRINT A1$: POKE 34,3: NORMAL : RETURN 
  33. 275  REM **OPEN FILES TO READ**
  34. 280  PRINT D$"OPEN ";FILE$",L";RL;",S";SX;",D";DX
  35. 285 RX =  INT(RX): PRINT D$"READ";FILE$",R";RX
  36. 290  RETURN 
  37. 295  REM **LIST FOOD DATA**
  38. 300  HOME : PRINT : FOR K = 1 TO NF: PRINT K;". ";T$(K);" - ";: INVERSE : PRINT P$(K): NORMAL : NEXT K: RETURN 
  39. 305  REM **DRAW FRAME**
  40. 310  VTAB 23: FOR K = 1 TO 39: PRINT "*";: NEXT K: PRINT : VTAB 1: FOR K = 1 TO 39: PRINT "*";: NEXT K: PRINT 
  41. 315  FOR K = 1 TO 22: PRINT "*";: HTAB 39: PRINT "*": NEXT K: RETURN 
  42. 320  REM **READ RECORD AND FIELD LENGTH DATA. NOTE HIDDEN CTRL B ADDED TO FILE NAME**
  43. 325  PRINT D$"OPEN";FILE$ +BC$;",S";SX;",D";DX
  44. 330  PRINT D$"READ";FILE$ +BC$
  45. 335  INPUT NF: INPUT RL: DIM T$(2 *NF),TV(NF),P$(NF)
  46. 340  FOR K = 1 TO NF: INPUT T$(K): INPUT TV(K): NEXT K
  47. 345  PRINT D$"CLOSE"FILE$ +BC$
  48. 350  RETURN 
  49. 355  REM **OPEN FILES TO READ**
  50. 360  PRINT D$"OPEN ";FILE$",L";RL;",S";SX;",D";DX
  51. 365  PRINT D$"READ";FILE$",R0"
  52. 370  RETURN 
  53. 375  REM **PRINT PAGE HEADING**
  54. 380  HTAB 3: PRINT "NO.";: HTAB 15: PRINT "FOOD";: HTAB 30: PRINT "NO.";: POKE 36,42: PRINT "FOOD";: POKE 36,57: PRINT "NO.";: POKE 36,69: PRINT "FOOD"
  55. 385  PRINT 
  56. 390 PP = PP +1:BL = 0
  57. 395  RETURN 
  58. 400  REM **PRINTER ON**
  59. 405  HOME : PRINT : PRINT "ENTER IN PRINTER SLOT #";G$: INPUT SLOT
  60. 410  IF  PEEK( -12506) = 183  THEN  GOTO 425
  61. 415  PRINT D$;"PR#1": PRINT 
  62. 420  POKE  -12527,0: POKE  -12526,82: POKE  -12528,7
  63. 425  PRINT D$"PR#";SLOT: POKE  -12527,0: POKE  -12526,82: POKE  -12528,7
  64. 430  RETURN 
  65. 435  REM **PRINT FOOD DATA LINES**
  66. 440  HTAB 3: PRINT RX(1);: HTAB 7: PRINT P$(1);: HTAB 30: PRINT RX(1);: HTAB 34: PRINT P$(2);: POKE 36,57: PRINT RX(3);: POKE 36,61: PRINT P$(3)
  67. 445  RETURN 
  68. 450  REM **EXTRACT FOOD QUANTITY AND UNITS FROM INPUT STRING**
  69. 455 LE =  LEN(A$):ER = 0
  70. 460  FOR K = 1 TO (LE -2):Y$ =  MID$ (A$,K,1): IF Y$ = "0"  OR Y$ = "."  THEN 470
  71. 465 Y =  VAL(Y$): IF Y = 0  THEN ER = 1: RETURN 
  72. 470  NEXT K
  73. 475  IF  RIGHT$(A$,2) = "GM"  THEN CO =  VAL( LEFT$(A$,LE -2))/100: RETURN 
  74. 480  IF  RIGHT$(A$,2) = "OZ"  THEN CO =  VAL( LEFT$(A$,LE -2)) *.28375: RETURN 
  75. 485  FOR K = 1 TO LE:Y$ =  MID$ (A$,K,1): IF Y$ = "0"  OR Y$ = "."  THEN 495
  76. 490  IF  VAL(Y$) = 0  THEN ER = 1: RETURN 
  77. 495  NEXT K
  78. 500 CO =  VAL(P$(3)) * VAL(A$):A$ = A$ +" * (" +P$(2) +")":A$ =  LEFT$(A$,19): RETURN 
  79. 505  PRINT QQ$"(Y/N)";G$;: GET A$: PRINT A$: IF A$ = "Y"  THEN YES = 1: RETURN 
  80. 510  IF A$ = "N"  THEN YES = 0: RETURN 
  81. 515  INVERSE : PRINT "PRESS 'Y' OR 'N'...": NORMAL : GOTO 505
  82. 520  REM **FOOD-QUANTITY LISTING**
  83. 525  VTAB 4: FOR K = 1 TO NI: PRINT PS$(K); TAB( 21);CS$(K): NEXT K:QQ$ = "FOODS & QUANTITIES OK ? ": VTAB 24: GOSUB 505: POKE 34,0: RETURN 
  84. 530  REM ** NUTRIENT LISTING **
  85. 535 AA$ = "  NUTRIENT LISTING  ":A1$ = " TOTAL SO FAR TODAY ": GOSUB 260: HOME : PRINT : PRINT 
  86. 540  PRINT  TAB( 6);"TOTAL CALORIES";: INVERSE : HTAB 26: PRINT PS(4): NORMAL : FOR K = 5 TO NF: PRINT  TAB( 6);T$(K); TAB( 26);: INVERSE : PRINT PS(K): NORMAL : NEXT K: POKE 34,0: RETURN 
  87. 545  REM **STORE PART DAY DATA**
  88. 550  FOR K = 4 TO NF:P$(K) =  LEFT$( STR$(PS(K)),TV(K)): NEXT K:RX = 0:FILE$ = NAME$ +"S PARTIAL DAILY NUTRIENTS"
  89. 555  GOSUB 230: FOR K = 1 TO NF: PRINT P$(K): NEXT K: PRINT D$"CLOSE";FILE$: RETURN 
  90. 560  REM **READ PART DAY NUTRIENTS FROM DISK**
  91. 565 RX = 0:FILE$ = NAME$ +"S PARTIAL DAILY NUTRIENTS"
  92. 570  GOSUB 275: FOR K = 1 TO NF: INPUT P$(K):PS(K) =  VAL(P$(K)): NEXT K: PRINT D$"CLOSE";FILE$
  93. 575  GOSUB 530
  94. 580  VTAB 22: PRINT  TAB( 2);"LAST FOOD ENTERED";: INVERSE : HTAB 20: PRINT P$(1)
  95. 585 QQ$ = "REMEMBER WHERE YOU WERE ? ": VTAB 24: HTAB 5: GOSUB 505:FILE$ = "FOOD": RETURN 
  96. 590  REM **IDEAL WEIGHT**
  97. 595  IF SEX$ = "M"  AND (H > = 61  AND H < = 75)  THEN 620
  98. 600  IF SEX$ = "F"  AND (H > = 56  AND H < = 70)  THEN 620
  99. 605  TEXT : HOME : PRINT "YOU ARE TOO SHORT OR TOO TALL TO FALL": PRINT : PRINT "WITHIN THE RANGE OF VALIDITY OF MY ": PRINT : PRINT "IDEAL WEIGHT CALCULATING ABILITY.": PRINT : PRINT : PRINT "I AM LIMITED TO MEN OF 156 CM(61 IN) TO"
  100. 610  PRINT : PRINT "190 CM(75 IN) OR WOMEN OF 142 CM(56 IN)": PRINT : PRINT "TO 178 CM(70 IN) HEIGHT.": VTAB 20:QQ$ = "READY TO RETURN TO THE MENU ": GOSUB 505: IF YES  THEN 1550:
  101. 615  GOTO 2020
  102. 620 HN = H/61:B0 = 1.1:B1 =  -1.8275:B2 = 1.72116: IF SEX$ = "F"  THEN HN = 61 *HN/56:B0 = 1.762:B1 =  -2.95:B2 = 2.1889
  103. 625 DE = .03:FR = 116
  104. 630  IF F$ = "M"  THEN DE = .045:FR = 124
  105. 635  IF F$ = "L"  THEN DE = .06:FR = 134
  106. 640  IF SEX$ = "F"  THEN FR = 95
  107. 645  IF (SEX$ = "F")  AND (F$ = "M")  THEN FR = 101
  108. 650  IF (SEX$ = "F")  AND (F$ = "L")  THEN FR = 112
  109. 655 WT = FR *(B0 +B1 *HN +B2 *HN ^2)
  110. 660  IF U$ = "K"  THEN WT = WT/2.20
  111. 665 WU =  INT(WT +DE *WT +.5):WL =  INT(WT -DE *WT +.5)
  112. 670 AA$ = "LBS": IF U$ = "K"  THEN AA$ = "KGMS"
  113. 675  RETURN 
  114. 680  REM **CALORIE/IDEAL WEIGHT DISPLAY**
  115. 685 CK = 28.08 -.717 *AL +.9428 *AL ^2
  116. 690  IF SEX$ = "M"  THEN CK = 1.15 *CK
  117. 695  GOSUB 590
  118. 700 CC = (WT/2.2) *CK: IF U$ = "K"  THEN CC = CC *2.2
  119. 705 CL = ( INT((CC -DE *CC +.5)/100)) *100:CU = ( INT((CC +DE *CC +.5)/100)) *100
  120. 710  RETURN 
  121. 715  HOME : REM **NAME INPUT ROUTINE**
  122. 720  VTAB 10: HTAB 5: PRINT "PLEASE PROVIDE YOUR NAME SO I ": VTAB 12: HTAB 8: PRINT "CAN IDENTIFY YOUR FILES.": VTAB 14: HTAB 10: PRINT "NAME ": VTAB 14: HTAB 15: INPUT NAME$: RETURN 
  123. 725  TEXT : HOME : REM **DATE-WEIGHT INPUT**
  124. 730  VTAB 10: HTAB 5: PRINT "ENTER DATE (YR/MO/DA) ";G$;: INPUT DA$
  125. 735  IF  LEN(DA$) <8  OR  LEN(DA$) >8  THEN 730
  126. 740 K =  VAL( LEFT$(DA$,2)): IF (K <81)  OR (K >99)  THEN 730
  127. 745 K =  VAL( MID$ (DA$,4,2)): IF K <1  OR K >12  THEN 730
  128. 750 K =  VAL( RIGHT$(DA$,2)): IF K <1  OR K >31  THEN 730
  129. 755  IF (( MID$ (DA$,3,1) =  CHR$(47)) = 1)  AND (( MID$ (DA$,6,1) =  CHR$(47)) = 1)  THEN  GOTO 765
  130. 760  GOTO 730
  131. 765  TEXT : HOME : VTAB 12: HTAB 16: PRINT DA$: VTAB 14: HTAB 6:QQ$ = "IS THE DATE CORRECT ? ": GOSUB 505: IF YES < >1  THEN 725
  132. 770  HOME : VTAB 12: HTAB 7: PRINT "YOUR ACTUAL WEIGHT TODAY": VTAB 14: HTAB 7: PRINT "IS ": VTAB 14: HTAB 10: INPUT WA$: VTAB 14: HTAB 10: PRINT WA$;" POUNDS": VTAB 14: HTAB 10: IF U$ = "K"  THEN  PRINT WA$;" KILOGRAMS"
  133. 775  VTAB 16: HTAB 7:QQ$ = "IS YOUR WEIGHT CORRECT ? ": GOSUB 505: IF YES < >1  THEN 770:
  134. 780  RETURN 
  135. 785  REM **PRESS ANY KEY TO CONTINUE**
  136. 790  VTAB 23: HTAB 7: INVERSE : PRINT "PRESS ANY KEY TO CONTINUE": VTAB 23: HTAB 32: GET Y$: PRINT Y$::: NORMAL : RETURN 
  137. 795  REM **TOTAL NUTRIENTS**
  138. 800 NU(4) = CI:NU(5) = .2 *CI/4:NU(6) = .3 *CI/9:NU(7) = .5 *CI/4
  139. 805 NU(8) = 800:NU(9) = 10:NU(11) = 5000:NU(12) = 1.2:NU(13) = 1.5:NU(14) = 16:NU(15) = 45:NU(16) = 99:NU(10) = 99
  140. 810  IF SEX$ = "F"  THEN NU(9) = 18:NU(11) = 4000:NU(12) = 1.0:NU(13) = 1.2:NU(14) = 13
  141. 815  RETURN 
  142. 820  REM **PERCENT NUTRIENTS**
  143. 825 AA$ = "    NUTRIENT  LISTING    ":A1$ = "PERCENTAGE OF DAILY NEEDS": GOSUB 260: HOME : PRINT : PRINT 
  144. 830  FOR K = 4 TO NF: PRINT  TAB( 8);PS$(K); TAB( 26);: INVERSE : PRINT P$(K): NORMAL : NEXT K: POKE 34,0: RETURN 
  145. 835  REM **READ PERSONAL DATA**
  146. 840  POKE 34,0: TEXT : HOME : VTAB 12: HTAB 2: PRINT "I'M GETTING YOUR PERSONAL DATA FILE":RX = 0:RL = 30:FILE$ = NAME$ +"S PERSONAL DATA": GOSUB 275: INPUT F$,SEX$,U$,H,AL: PRINT D$"CLOSE";FILE$
  147. 845  FOR K = 1 TO 2000: NEXT : HOME : VTAB 12: HTAB 10: PRINT "I FOUND IT ";NAME$: FOR K = 1 TO 2000: NEXT : RETURN 
  148. 850  GOSUB 320: REM **READ FOOD FILES AND SETUP**
  149. 855  DIM PS(NF),P(NF),PS$(20),CS$(20)
  150. 860 RX = 0: GOSUB 275: INPUT REC: PRINT D$"CLOSE";FILE$: RETURN 
  151. 865  REM **FOOD QUANTITY INPUT**
  152. 870  GOSUB 275: FOR K = 1 TO NF: INPUT P$(K): NEXT K: PRINT D$"CLOSE";FILE$:NI = NI +1
  153. 875  HOME : VTAB 6: HTAB 1: PRINT "THE NEXT FOOD IS -- ";P$(1): VTAB 8: HTAB 1: PRINT "STANDARD SERVING : ";P$(2)
  154. 880  VTAB 15: HTAB 14: INVERSE : PRINT "INSTRUCTIONS": NORMAL : VTAB 17: HTAB 4: PRINT "THREE CHOICES FOR FOOD MEASUREMENT": VTAB 19: HTAB 4: PRINT "STANDARD SERVINGS-NUMBER (I.E. - 1) 
  155. 885  VTAB 21: HTAB 4: PRINT "GRAMS - SUFFIX GM (I.E. - 114GM)": VTAB 23: HTAB 4: PRINT "OUNCES - SUFFIX OZ (I.E. - 4OZ)"
  156. 890  VTAB 13: HTAB 6: PRINT "ENTER ";: FLASH : PRINT "0";: NORMAL : PRINT " IF THE FOOD IS WRONG"
  157. 895  VTAB 11: HTAB 12: PRINT "QUANTITY ": VTAB 11: HTAB 20: INPUT A$
  158. 900  GOSUB 455: RETURN 
  159. 905  REM **CALCULATE PERCENTAGE**
  160. 910  GOSUB 795: FOR K = 4 TO NF:P(K) =  INT(PS(K) *100/NU(K)): NEXT 
  161. 915  FOR K = 4 TO NF:P$(K) =  STR$(P(K)) +" %": NEXT 
  162. 920 P$(10) = "NOT SPECIFIED":P$(16) = P$(10)
  163. 925  TEXT : HOME : GOSUB 820: RETURN 
  164. 930  REM **NEXT FOOD REQUEST**
  165. 935  TEXT : HOME : NORMAL : VTAB 13: HTAB 6: PRINT "PRESS ";: FLASH : PRINT "RETURN";: NORMAL : PRINT " IF FINISHED"
  166. 940  VTAB 20: HTAB 11: PRINT G$;G$: VTAB 10: HTAB 6: INPUT "RECORD NUMBER OF NEXT FOOD ? ";A$: VTAB 10: HTAB 38
  167. 945  IF  LEN(A$) = 0  THEN  RETURN 
  168. 950 RX =  INT( VAL(A$)): IF ((RX <1)  OR (RX >REC))  THEN  VTAB 16: INVERSE : HTAB 5: PRINT "ONLY ";REC;" RECORDS ON THE FOOD FILES": NORMAL : FOR K = 1 TO 2000: NEXT K: GOTO 935
  169. 955  GOSUB 865: RETURN 
  170. 960  REM **ADD NUTRIENTS**
  171. 965 PS$(NI) = P$(1):CS$(NI) = A$
  172. 970  FOR K = 4 TO NF:P(K) =  VAL(P$(K)):PS(K) = PS(K) +CO *P(K): NEXT K: TEXT : HOME : RETURN 
  173. 975  REM **FILLED SCREEN MESSAGE**
  174. 980  TEXT : HOME : VTAB 5: PRINT "I HAVE A SCREEN FULL OF FOOD TO CONTEND": VTAB 7: PRINT "WITH. I CAN COPE WITH ONLY 20 ITEMS.": RETURN 
  175. 985  REM **ESTABLISH RECORD NUMBER**
  176. 990  HOME :FILE$ = "FOOD": GOSUB 320:RX = 0: GOSUB 275
  177. 995  INPUT REC:REC = REC +1
  178. 1000  PRINT D$"CLOSE";FILE$: RETURN 
  179. 1005  REM **FOOD RECORD TO DISK**
  180. 1010 RX = REC: GOSUB 230:
  181. 1015  FOR KK = 1 TO NF: PRINT P$(KK): NEXT KK
  182. 1020  PRINT D$"CLOSE": RETURN 
  183. 1025  REM **INITIALIZER SUBROUTINE**
  184. 1030  REM **NOTE THE HIDDEN CTRL B (BC$=CHR$(2) ) APPENDED TO FOOD.THIS WILL NOT SHOW IN THE CATALOG**
  185. 1035 RL = 0:N = 16:FILE$ = "FOOD"
  186. 1040  FOR K = 1 TO N
  187. 1045 RL = RL +TV(K): NEXT K:RL = RL +N
  188. 1050  PRINT D$"OPEN";FILE$ +BC$;",S"SX;",D"DX
  189. 1055  PRINT D$"WRITE";FILE$ +BC$
  190. 1060  PRINT N: PRINT RL: FOR K = 1 TO N: PRINT T$(K): PRINT TV(K): NEXT K
  191. 1065  PRINT D$"CLOSE";FILE$ +BC$
  192. 1070  PRINT D$"LOCK";FILE$ +BC$
  193. 1075  PRINT D$"OPEN ";FILE$",L";RL
  194. 1080  PRINT D$"WRITE";FILE$",R0"
  195. 1085  PRINT 0
  196. 1090  PRINT D$"CLOSE"
  197. 1095  TEXT : HOME 
  198. 1100  VTAB 12: HTAB 4: INVERSE : PRINT "FOOD LIST FILE PARAMETERS FIXED": VTAB 12: HTAB 34: FOR K = 1 TO 1500: NEXT K: NORMAL 
  199. 1105  HOME : PRINT D$;"CATALOG,S"SX;",D"DX
  200. 1110  FOR K = 1 TO 5000: NEXT K: RETURN 
  201. 1495  REM **SUBROUTINES ABOVE** 
  202. 1500  REM **REPEAT MAIN MENU**
  203. 1510 G$ =  CHR$(7): TEXT : HOME 
  204. 1520  REM **MAIN MENU**
  205. 1530 V1 = 8: DIM M$(V1):B$ = "                              ": REM     30 SPACES 
  206. 1540 BC$ =  CHR$(2):D$ =  CHR$(4):G$ =  CHR$(7):H$ =  CHR$(8):V1$ =  CHR$(91):V2$ =  CHR$(93)
  207. 1550  TEXT : HOME : GOSUB 305
  208. 1560 AA$ = "  NIBBLE   DINER  ":A1$ = "    MAIN  MENU    ": GOSUB 260: RESTORE 
  209. 1570  FOR K = 1 TO V1: READ M$(K): NEXT K
  210. 1580  DATA       "SET UP USER DATA FILES","ENTER FOOD DATA","DISPLAY FOOD DATA MENU","CHANGE/DELETE FOOD DATA","NUTRITION ANALYSIS MENU","RECIPE EVALUATION"
  211. 1590  DATA   "TO BE ASSIGNED"   ,"END PROGRAM" 
  212. 1600  FOR K = 1 TO V1: VTAB (2 *K +3): HTAB 8: PRINT K;". ";M$(K): NEXT K
  213. 1610  VTAB 22: HTAB 4: PRINT "ENTER CHOICE (BY NUMBER): ";G$;V1$;" ";V2$;H$;H$;: NORMAL : GET Y$: PRINT Y$:Y =  VAL(Y$): IF Y <1  OR Y >V1  THEN 1610
  214. 1620  VTAB 2 *Y +3: HTAB 8: INVERSE : PRINT Y;". ";M$(Y): NORMAL : FOR KK = 1 TO 400: NEXT KK
  215. 1630  IF Y = V1  THEN 25000
  216. 1640 SX =  PEEK(768):DX =  PEEK(769): IF SX >0  OR DX = 2  THEN 1730
  217. 1650 QQ$ = "DEFAULT DRIVE OK-SLOT 6 DRIVE 1 ? ": POKE 34,0: HOME : VTAB 12: HTAB 1: GOSUB 505: IF YES  THEN SX = 6:DX = 1: GOTO 1720
  218. 1660  TEXT : HOME : VTAB 6: CALL  -958: PRINT "ENTER  SLOT #: ";G$;: GET SX$: PRINT SX$:SX =  VAL(SX$)
  219. 1670  IF SX <1  OR SX >7  THEN 1660
  220. 1680  VTAB 8: CALL  -868: PRINT "ENTER DRIVE #: ";G$;: GET DX$: PRINT DX$:DX =  VAL(DX$)
  221. 1690  IF (DX -1) *(DX -2) < >0  THEN 1680
  222. 1700  VTAB 10: CALL  -958: PRINT "SLOT # = ";SX: PRINT "DRIVE # = ";DX: GOSUB 205: IF Y$ = "N"  THEN 1660
  223. 1710  IF Y$ < >"Y"  THEN 1660
  224. 1720  POKE 768,SX: POKE 769,DX
  225. 1730  ON Y GOTO 2000,3000,10000,4000,5000,13000,14000,25000
  226. 2000  REM **INTRODUCTION ROUTINE**
  227. 2010  TEXT : HOME : GOSUB 715
  228. 2020  TEXT : HOME : VTAB 04: HTAB 5: PRINT "I WILL ASK YOU SOME QUESTIONS": VTAB 6: HTAB 5: PRINT "TO ESTABLISH YOUR IDEAL WEIGHT"
  229. 2030  VTAB 9: HTAB 11: PRINT " YOUR FRAME SIZE ?": VTAB 10: HTAB 8: PRINT "S)MALL M)EDIUM L)ARGE ?": VTAB 10: HTAB 31: GET F$: PRINT F$: IF F$ = "S"  OR F$ = "M"  OR F$ = "L"  THEN  GOTO 2050
  230. 2040  GOTO 2030
  231. 2050  VTAB 12: HTAB 7: PRINT "YOUR SEX ?  M)ALE F)EMALE ?": VTAB 12: HTAB 34: GET SEX$: PRINT SEX$: IF SEX$ = "F"  OR SEX$ = "M"  THEN  GOTO 2070
  232. 2060  GOTO 2050
  233. 2070  VTAB 14: HTAB 5: INVERSE : PRINT "HEIGHT AND WEIGHT MEASURED BY :": VTAB 15: HTAB 8: NORMAL : PRINT "K)ILOGRAMS AND CENTIMETRES": VTAB 16: HTAB 5: PRINT "OR P)OUNDS AND INCHES": VTAB 17: HTAB 7: PRINT "?": VTAB 17: HTAB 8: GET U$
  234. 2080  VTAB 17: HTAB 8: PRINT U$: IF U$ = "K"  OR U$ = "P"  THEN  GOTO 2100
  235. 2090  GOTO 2070
  236. 2100  VTAB 19: HTAB 5: INPUT "YOUR HEIGHT IS ";H: VTAB 19: HTAB 5: CALL  -958: PRINT "YOUR HEIGHT IS ";H;" ";: IF U$ = "K"  THEN  PRINT "CENTIMETRES": GOTO 2120
  237. 2110  PRINT "INCHES"
  238. 2120  VTAB 23:QQ$ = " IS THE INFORMATION CORRECT ? ": GOSUB 505: IF   NOT YES  THEN  GOTO 2020
  239. 2130  IF U$ = "K"  THEN H = .0328 *H *12
  240. 2140  GOSUB 590: PRINT G$: PRINT G$: FLASH : PRINT " YOUR IDEAL WEIGHT IS ";WL;" TO ";WU;" ";AA$: PRINT : PRINT : PRINT : NORMAL 
  241. 2150  GOSUB 785
  242. 2160  TEXT : HOME : VTAB 2: PRINT "I WILL ASK YOU TO ESTABLISH YOUR ACTIV-": VTAB 3: PRINT "ITY LEVEL FOR MY FUTURE REFERENCE FROM": VTAB 4: PRINT "THE FOLLOWING TABLE."
  243. 2170  VTAB 6: PRINT "1. RESTING (MINIMUM ENERGY-NO EXERCISE)": VTAB 8: PRINT "2. SEDENTARY (SITTING OCCUPATIONS)": VTAB 10: PRINT "3. LIGHT (STANDING OCCUPATIONS-TEACHING)": VTAB 12: PRINT "4. MODERATE (HOUSEWORK-GARDENING-WALK)"
  244. 2180  VTAB 14: PRINT "5. ACTIVE (MANUAL LABOR-SKATING-DANCING)"
  245. 2190  VTAB 18: INPUT "CHOOSE A NUMBER FROM 1.0 TO 5.0 ? ";AL: IF (AL <1)  OR (AL >5)  THEN  HOME : FLASH : VTAB 12: HTAB 07: PRINT "ACTIVITY LEVEL OUT OF RANGE": FOR K = 1 TO 2000: NEXT K: NORMAL : GOTO 2160
  246. 2200  HOME : GOSUB 680: VTAB 8: PRINT "YOU NEED TO CONSUME ";CL;" TO ";CU: VTAB 10: PRINT "CALORIES TO MAINTAIN YOUR IDEAL WEIGHT": VTAB 12: PRINT "OF ";WL;" TO ";WU;" ";AA$
  247. 2210  GOSUB 785
  248. 2220  HOME :QQ$ = "SAVE YOUR PERSONAL DATA ON DISK ": VTAB 12: HTAB 2: GOSUB 505: IF YES  THEN RX = 0:RL = 30:FILE$ = NAME$ +"S PERSONAL DATA": GOSUB 230: PRINT F$: PRINT SEX$: PRINT U$: PRINT H: PRINT AL: PRINT D$"CLOSE";FILE$: GOTO 2240
  249. 2230  GOTO 2250
  250. 2240  VTAB 16: PRINT "YOUR FILE NAMED ";FILE$: FOR K = 1 TO 3000: NEXT 
  251. 2250  HOME :QQ$ = "START A NEW WEIGHT RECORD ": VTAB 12: HTAB 2: GOSUB 505: IF YES  THEN RX = 0:RL = 20:FILE$ = NAME$ +"S WEIGHT RECORD": GOSUB 230: PRINT RX: PRINT D$"CLOSE";FILE$: GOTO 2270
  252. 2260  GOTO 2280
  253. 2270  VTAB 16: PRINT "YOUR FILE NAMED ";FILE$: FOR K = 1 TO 3000: NEXT 
  254. 2280  HOME :QQ$ = "START A FOOD DATA BASE ": VTAB 12: HTAB 2: GOSUB 505: IF YES  THEN 2300
  255. 2290  CLEAR : GOTO 1500
  256. 2300  HOME : VTAB 8: PRINT "ARE YOU SURE ? THIS IS REQUIRED ONLY": VTAB 10: PRINT "IF YOU DO NOT HAVE FILES CALLED ": VTAB 12: PRINT "'FOOD' ON YOUR DISKS OR WISH TO START": VTAB 14: PRINT "A NEW FOOD DATA BASE.PRESS ANY KEY": VTAB 16
  257. 2310  PRINT "TO CHECK YOUR CATALOG AND ESCAPE TO": VTAB 18: PRINT "THE MAIN MENU.": VTAB 22: INPUT "ENTER 'YES' TO ESTABLISH FILES ";Y$
  258. 2320  IF Y$ < >"YES"  THEN  GOSUB 1105: CLEAR : GOTO 1500
  259. 2330 V = 16: DIM T$(V),T(2 *V),TV(2 *V)
  260. 2340 T$(1) = "FOOD":T$(2) = "MEASURE":T$(3) = "CONVERSION":T$(4) = "CALORIES-100GM":T$(5) = "PROTEIN-GM":T$(6) = "FAT-GM":T$(7) = "CARBOHYDRATE-GM":T$(8) = "CALCIUM-MGM":T$(9) = "IRON-MGM":T$(10) = "SODIUM-MGM"
  261. 2350 T$(11) = "VITAMIN A-IU":T$(12) = "THIAMINE-MGM":T$(13) = "RIBOFLAVIN-MGM":T$(14) = "NIACIN-MGM":T$(15) = "VITAMIN C-MGM":T$(16) = "CHOLESTEROL-MGM"
  262. 2360 TV(1) = 20:TV(2) = 20:TV(3) = 6:TV(4) = 6:TV(5) = 6:TV(6) = 6:TV(7) = 6:TV(8) = 6:TV(9) = 6:TV(10) = 6:TV(11) = 6:TV(12) = 6:TV(13) = 6:TV(14) = 6:TV(15) = 6:TV(16) = 6
  263. 2370  GOSUB 1025: CLEAR : GOTO 1500
  264. 3000  REM **DATA ENTRY SUBROUTINE**
  265. 3010 A1$ = "   DATA   ENTRY   "
  266. 3020  TEXT : HOME : GOSUB 260: GOSUB 985
  267. 3030  HOME : PRINT : PRINT "THIS WILL BE RECORD # ";REC
  268. 3040  VTAB 23: PRINT "RETURN ON ";: INVERSE : PRINT T$(1);: NORMAL : PRINT " TO QUIT": VTAB 6
  269. 3050  FOR K = 1 TO NF
  270. 3060  GOSUB 215
  271. 3070  IF  LEN(P$(1)) = 0  THEN 3160
  272. 3080  IF  LEN(P$(K)) < = TV(K)  THEN 3100
  273. 3090  PRINT "ENTRY TOO LONG";G$;G$: FOR KK = 1 TO 750: NEXT KK: VTAB (CV +1): HTAB 1: CALL  -958: GOTO 3060
  274. 3100  NEXT K
  275. 3110  GOSUB 205
  276. 3120  IF Y$ = "N"  THEN 3210
  277. 3130  IF Y$ < >"Y"  THEN 3110
  278. 3140  GOSUB 1005
  279. 3150 REC = REC +1: GOTO 3030
  280. 3160 REC = REC -1:RX = 0
  281. 3170  GOSUB 230
  282. 3180  PRINT REC
  283. 3190  PRINT D$"CLOSE"
  284. 3200  CLEAR : GOTO 1500
  285. 3210  GOSUB 295: PRINT NF +1;". *ABORT*"
  286. 3220  VTAB 23: HTAB 10: GOSUB 250: PRINT : VTAB 21: PRINT "ENTER LINE # OF INCORRECT DATA: ";G$;: INPUT Z$:Z =  VAL(Z$)
  287. 3230  HOME : VTAB 12: HTAB 10: PRINT "PLEASE MAKE CORRECTIONS"
  288. 3240  IF Z$ = ""  THEN  VTAB 12: HTAB 10: PRINT B$: GOTO 3140
  289. 3250  IF Z = NF +1  THEN 3030
  290. 3260  IF Z <1  OR Z >NF  THEN 3210
  291. 3270 K = Z
  292. 3280  VTAB 18: GOSUB 215
  293. 3290  IF  LEN(P$(K)) < = TV(K)  THEN 3310
  294. 3300  PRINT "ENTRY TOO LONG";G$;G$: FOR KK = 1 TO 750: NEXT KK: VTAB (CV +1): HTAB 1: CALL  -958: GOTO 3280
  295. 3310  GOTO 3210
  296. 4000  REM **CHANGE/DELETE DATA**
  297. 4010 A1$ = "CHANGE/DELETE DATA"
  298. 4020  TEXT : HOME : GOSUB 260: HOME :FILE$ = "FOOD": GOSUB 320:RX = 0: GOSUB 275
  299. 4030  INPUT REC
  300. 4040  PRINT D$"CLOSE";FILE$
  301. 4050  HOME : VTAB 23: HTAB 10: GOSUB 250: VTAB 5: PRINT : PRINT "ENTER RECORD # TO CHANGE/DELETE ";G$;: INPUT RD$
  302. 4060  IF  LEN(RD$) = 0  THEN  CLEAR : GOTO 1500
  303. 4070 RD =  INT( VAL(RD$)): IF RD < = 0  THEN 4050
  304. 4080  IF RD < = REC  THEN 4100
  305. 4090  PRINT : PRINT "ONLY ";REC;" RECORDS ON FILE!": PRINT : PRINT "PRESS RETURN TO CONTINUE.";G$;G$;: INPUT Y$: GOTO 4050
  306. 4100 RX = RD: IF RX < = 0  THEN RX = 0
  307. 4110  GOSUB 275: FOR K = 1 TO NF: INPUT P$(K): NEXT K
  308. 4120  PRINT D$"CLOSE";FILE$
  309. 4130  GOSUB 295
  310. 4140  VTAB 22: CALL  -868: PRINT "CHANGE/DELETE RECORD # ";RD;" (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN 4050
  311. 4150  IF Y$ < >"Y"  THEN 4140
  312. 4160  VTAB 22: CALL  -868: PRINT "CHANGE (C), DELETE (D), OR ABORT (CR) ";G$;: GET Y$: PRINT Y$
  313. 4170  IF Y$ =  CHR$(13)  THEN 4050
  314. 4180  IF Y$ = "C"  THEN 4320
  315. 4190  IF Y$ < >"D"  THEN 4160
  316. 4200  VTAB 22: CALL  -868: PRINT "VERIFY DELETION (YES/NO): ";G$;: INPUT Y$: IF Y$ < >"YES"  THEN 4050
  317. 4210  IF RD < >REC  THEN 4250
  318. 4220 RX = 0:REC = REC -1: GOSUB 240: PRINT REC
  319. 4230  PRINT D$;"CLOSE";FILE$
  320. 4240  GOTO 4050
  321. 4250 RX = REC: GOSUB 275: FOR K = 1 TO NF: INPUT P$(K): NEXT K
  322. 4260  PRINT D$;"CLOSE";FILE$
  323. 4270 RX = RD: GOSUB 230: FOR K = 1 TO NF: PRINT P$(K): NEXT K
  324. 4280  PRINT D$;"CLOSE";FILE$
  325. 4290 REC = REC -1:RX = 0: GOSUB 230: PRINT REC
  326. 4300  PRINT D$;"CLOSE";FILE$
  327. 4310  GOTO 4050
  328. 4320  REM CHANGE ROUTINE
  329. 4330  VTAB 23: HTAB 10: GOSUB 250: PRINT : VTAB 22: CALL  -868: PRINT "ENTER FIELD # TO CHANGE: ";G$;: INPUT Y$:Y =  VAL(Y$): IF Y = 0  THEN 4410
  330. 4340  HOME : VTAB 12: HTAB 10: PRINT "PLEASE MAKE CORRECTIONS"
  331. 4350  IF  INT(Y) <1  OR  INT(Y) >NF  THEN 4330
  332. 4360 K = Y
  333. 4370  VTAB 17: GOSUB 215
  334. 4380  IF  LEN(P$(Y)) < = TV(Y)  THEN 4400
  335. 4390  VTAB 23: CALL  -868: HTAB 10: PRINT "ENTRY TOO LONG!";G$;G$: FOR KK = 1 TO 500: NEXT KK: VTAB 23: HTAB 10: GOSUB 250: PRINT : GOTO 4370
  336. 4400  GOSUB 295: GOTO 4330
  337. 4410 RX = RD: GOSUB 230: FOR K = 1 TO NF: PRINT P$(K): NEXT K
  338. 4420  PRINT D$"CLOSE";FILE$
  339. 4430  GOTO 4050
  340. 5000  REM **DIET ANALYSIS MENU**
  341. 5010  GOSUB 715
  342. 5020 V1 = 5:B$ = "                              ": REM 30 SPACES
  343. 5030 BC$ =  CHR$(2):D$ =  CHR$(4):G$ =  CHR$(7):H$ =  CHR$(8):V1$ =  CHR$(91):V2$ =  CHR$(93)
  344. 5040  TEXT : HOME : GOSUB 305
  345. 5050 AA$ = "  NIBBLE  DINER  ":A1$ = "  ANALYSIS MENU  ": GOSUB 260
  346. 5060 M$(1) = "DAILY NUTRITION ANALYSIS":M$(2) = "LONG TERM ANALYSIS":M$(3) = "TO BE ASSIGNED":M$(4) = "TO BE ASSIGNED":M$(5) = "RETURN TO MAIN MENU"
  347. 5070  FOR K = 1 TO V1: VTAB (2 *K +3): HTAB 8: PRINT K;". ";M$(K): NEXT K
  348. 5080  VTAB 22: HTAB 4: PRINT "ENTER CHOICE (BY NUMBER): ";G$;V1$;" ";V2$;H$;H$;: NORMAL : GET Y$: PRINT Y$:Y =  VAL(Y$): IF Y <1  OR Y >V1  THEN 5080
  349. 5090  VTAB 2 *Y +3: HTAB 8: INVERSE : PRINT Y;". ";M$(Y): NORMAL : FOR KK = 1 TO 400: NEXT KK
  350. 5100  IF Y = V1  THEN  CLEAR : GOTO 1500
  351. 5110 SX =  PEEK(768):DX =  PEEK(769)
  352. 5120  ON Y GOTO 6000,7000,8000,9000,1500
  353. 6000  REM **DAILY NUTRITION ANALYSIS**
  354. 6010  TEXT : HOME : GOSUB 305:AA$ = "DAILY CALORIE AND VITAMIN":A1$ = "INTAKE CALCULATION": GOSUB 260: VTAB 10: HTAB 5: PRINT "IS THIS THE BEGINNING OF A NEW": VTAB 12: HTAB 5: PRINT "DAILY RECORD OR A CONTINUATION "
  355. 6020  VTAB 14: HTAB 6: PRINT "OF ONE STARTED EARLIER TODAY"
  356. 6030  VTAB 18: HTAB 6: PRINT "NEW OR CONTINUING ? (N/C) ?";G$;: GET Y$: PRINT Y$
  357. 6040  IF ((Y$ < >"C")  AND (Y$ < >"N"))  THEN 6030
  358. 6050  POKE 34,0: HOME :FILE$ = "FOOD": VTAB 11: HTAB 13: PRINT "READING FILES": VTAB 11: HTAB 26
  359. 6070  GOSUB 850
  360. 6080  FOR K = 1 TO NF:PS(K) = 0:P(K) = 0: NEXT K:NI = 0
  361. 6090  IF Y$ = "C"  THEN  GOSUB 560: IF YES = 0  THEN  HOME : VTAB 8: PRINT "SORRY! PLEASE START AGAIN FOR TODAY": GOSUB 785: CLEAR : GOTO 1500
  362. 6100  GOSUB 930
  363. 6110  IF  LEN(A$) = 0  THEN 6160
  364. 6120  IF ER  THEN  GOTO 6100
  365. 6130  GOSUB 960
  366. 6140  IF NI = 20  THEN  GOSUB 975: VTAB 15: PRINT "PLEASE FINISH THIS SESSION AND BEGIN": VTAB 17: PRINT "ANOTHER IF YOU HAVE ADDITIONAL ITEMS TO": VTAB 19: PRINT "EVALUATE.": GOSUB 785
  367. 6150  IF NI <20  THEN 6100
  368. 6160  TEXT : HOME :AA$ = "    LIST OF FOODS   ":A1$ = "ENTERED THIS SESSION": GOSUB 260: VTAB 23: INVERSE : PRINT "Y)ES-ADDITIONS ALLOWED N)O-NEW START": NORMAL : GOSUB 520
  369. 6170  IF YES = 0  THEN  TEXT : HOME : VTAB 10: HTAB 11: PRINT "SESSION DISCONTINUED": VTAB 12: HTAB 15: PRINT "BEGIN AGAIN": FOR K = 1 TO 3000: NEXT K: CLEAR : GOTO 1500
  370. 6180 QQ$ = "FORGET ANYTHING ? ": TEXT : HOME : VTAB 12: HTAB 09: GOSUB 505: IF YES  THEN 6100
  371. 6190 QQ$ = "WANT A TOTAL NUTRIENT LISTING ? ": HOME : VTAB 12: HTAB 2: GOSUB 505: IF YES  THEN  GOSUB 530
  372. 6200 QQ$ = "WILL YOU EAT MORE TODAY ? ": VTAB 23: HTAB 5: GOSUB 505: IF YES  THEN  GOSUB 545: HOME : VTAB 11: PRINT "TOTAL CALORIES CONSUMED STORED ON DISK": FOR K = 1 TO 1500: NEXT 
  373. 6210  IF YES  THEN  HOME : VTAB 10: HTAB 8: PRINT "PART DAY REPORT FOLLOWS": FOR K = 1 TO 1500: NEXT 
  374. 6220  GOSUB 835
  375. 6230  IF YES  THEN 6250
  376. 6240  HOME : VTAB 12: PRINT "NOW I NEED YOUR WEIGHT AND THE DATE.": FOR K = 1 TO 1500: NEXT : GOSUB 725:YES = 0
  377. 6250  REM **IDEAL WEIGHT AND NEEDED CALORIES**
  378. 6260  GOSUB 680:WI =  INT(WT +.5):CI = ( INT(CC)): HOME 
  379. 6270  IF YES  THEN 6430
  380. 6280  REM **ACTUAL WEIGHT AND NEEDED CALORIES
  381. 6290 WA =  INT( VAL(WA$)):
  382. 6300 CA = (WA/2.2) *CK: IF U$ = "K"  THEN CA = WA *CK
  383. 6310 UN$ = "POUNDS": IF U$ = "K"  THEN UN$ = "KILOGRAMS"
  384. 6320 CW = (CA -PS(4)) *7/3500: IF U$ = "K"  THEN CW = CW/2.2
  385. 6330 CH$ = "LOSE": IF CW <0  THEN CH$ = "GAIN"
  386. 6340 CW =  ABS(CW):CW = ( INT(CW *10)/10)
  387. 6350  VTAB 2: PRINT "YOU HAVE CONSUMED "; INT(PS(4));" CALORIES": VTAB 5: PRINT "YOU WILL ";CH$;" ABOUT ";CW;" ";UN$;" A WEEK": VTAB 07: PRINT "AT THIS RATE OF EATING"
  388. 6360  VTAB 10: PRINT "YOU NEED TO EAT ABOUT ";CI;" CALORIES TO": VTAB 12: PRINT "MAINTAIN YOUR IDEAL WEIGHT OF ";WI: VTAB 14: PRINT UN$;"."
  389. 6370  VTAB 17: PRINT "EATING "; INT(CA);" PER DAY WILL MAINTAIN": VTAB 19: PRINT "YOUR ACTUAL WEIGHT OF ";WA;" ";UN$
  390. 6380  GOSUB 785
  391. 6390 PR =  INT(100 *4 *PS(5)/PS(4)):FA =  INT(100 *9 *PS(6)/PS(4)):CB = (100 -PR -FA): HOME 
  392. 6400  VTAB 2: PRINT "THE TOTAL CALORIES YOU CONSUMED TODAY": VTAB 4: PRINT "WERE MADE UP OF:": VTAB 6: PRINT  TAB( 12);"CARBOHYDRATE"; TAB( 25);CB;"%": VTAB 8: PRINT  TAB( 12);"FAT"; TAB( 25);FA;"%"
  393. 6410  VTAB 10: PRINT  TAB( 12);"PROTEIN"; TAB( 25);PR;"%": VTAB 12: PRINT "THE AMERICAN HEART ASSOCIATION SUGGESTS": VTAB 14: PRINT "A CALORIE MAKEUP FROM:": VTAB 16: PRINT  TAB( 12);"CARBOHYDRATE"; TAB( 25);"50%"
  394. 6420  VTAB 18: PRINT  TAB( 12);"FAT"; TAB( 25);"30%": VTAB 20: PRINT  TAB( 12);"PROTEIN"; TAB( 25);"20%": GOSUB 785
  395. 6430  FOR K = 4 TO NF: READ PS$(K): NEXT 
  396. 6440  DATA     "CALORIES", "PROTEIN","FAT","CARBOHYDRATE","CALCIUM", "IRON","SODIUM", "VITAMIN A", "THIAMINE", "RIBOFLAVIN","NIACIN","VITAMIN C", "CHOLESTEROL"  
  397. 6450  DIM NU(NF): GOSUB 905: GOSUB 785
  398. 6460  IF YES  THEN  HOME : VTAB 10: HTAB 7: PRINT "I WILL SEE YOU LATER TODAY": END 
  399. 6470 RX = 0:RL = 20:FILE$ = NAME$ +"S WEIGHT RECORD": GOSUB 275: INPUT DY: PRINT D$"CLOSE";FILE$:RX = DY +1: GOSUB 230: PRINT  INT(PS(4)): PRINT DA$: PRINT WA: PRINT D$"CLOSE";FILE$
  400. 6480 RX = 0: GOSUB 230: PRINT DY +1: PRINT D$"CLOSE";FILE$:
  401. 6490  TEXT : HOME : VTAB 10: PRINT "I SAVED  YOUR WEIGHT, THE DATE AND ": VTAB 12: PRINT "THE TOTAL CALORIES YOU CONSUMED TODAY": VTAB 14: PRINT "FOR FUTURE REFERENCE"
  402. 6500  VTAB 18: PRINT G$;G$;G$: PRINT "GOODNIGHT " +NAME$;". I'LL SEE YOU TOMORROW": END 
  403. 7000  REM **LONG TERM ANALYSIS**
  404. 7010  TEXT : HOME : VTAB 12: HTAB 8: PRINT "WORKING! DO NOT DISTURB."
  405. 7020 RX = 0:RL = 20:FILE$ = NAME$ +"S WEIGHT RECORD": GOSUB 275: INPUT DY: PRINT D$"CLOSE";FILE$: DIM WZ(DY)
  406. 7030  IF DY = 0  THEN  HOME : VTAB 10: PRINT "YOU HAVE NOT ESTABLISHED A WEIGHT": VTAB 12: PRINT "RECORD ";NAME$: FOR K = 1 TO 2500: NEXT K: GOTO 5020
  407. 7040  PRINT D$"OPEN";FILE$",L";RL;",S";SX;",D";DX:C = 0:W = 0
  408. 7050  FOR K = 1 TO DY:RX = K: GOSUB 285: INPUT PS(4),DA$,WZ(K):C = C +PS(4):W = W +WZ(K): NEXT K: PRINT D$"CLOSE";FILE$
  409. 7060 C = C/DY:WX = WZ(1) -WZ(DY):W = W/DY
  410. 7070  GOSUB 835: REM **GET PERSONAL DATA**
  411. 7080  GOSUB 680: REM **IDEAL WEIGHT & CALORIES**
  412. 7090 WI =  INT(WT +.5):CI =  INT(CC +.5)
  413. 7100 UN$ = "POUNDS": IF U$ = "K"  THEN UN$ = "KILOGRAMS"
  414. 7110 CH$ = "LOSS": IF WL <0  THEN CH$ = "GAIN"
  415. 7120  HOME : VTAB 8: PRINT "PLEASE USE THE INFORMATION TO COME TO": VTAB 10: PRINT "ADJUST YOUR CALORIE INTAKE OR": VTAB 12: PRINT "ACTIVITY LEVEL TO ACHIEVE YOUR ": VTAB 14: PRINT "WEIGHT GOAL ";NAME$
  416. 7130  GOSUB 785
  417. 7140  TEXT : HOME : PRINT "DURING THE ";DY;" DAY PERIOD": VTAB 3: PRINT "ENDING ";DA$;" YOU CONSUMED AN": VTAB 5: PRINT "AVERAGE "; INT(C);" CALORIES PER DAY."
  418. 7150  VTAB 8: PRINT "I ESTIMATED THAT YOU NEEDED TO EAT": VTAB 10: PRINT CI;" CALORIES PER DAY TO MAINTAIN ": VTAB 12: PRINT "YOUR IDEAL WEIGHT OF ";WI;" ";UN$;"."
  419. 7160  VTAB 15: PRINT "YOUR AVERAGE WEIGHT DURING THE PERIOD": VTAB 17: PRINT "WAS ";W;" ";UN$;".";"YOUR WEIGHT": VTAB 19: PRINT CH$;" DURING THE ";DY;" DAY PERIOD WAS": VTAB 21: PRINT  ABS(WX);" ";UN$;"."
  420. 7170  GOSUB 785: CLEAR : GOTO 1500
  421. 8000  REM **TO BE ASSIGNED**
  422. 8010  TEXT : HOME : VTAB 10: PRINT "TO BE ASSIGNED AT PROGRAM LINE 8010": GOSUB 785: GOTO 5040
  423. 9000  REM **TO BE ASSIGNED**
  424. 9010  TEXT : HOME : VTAB 10: PRINT "TO BE ASSIGNED AT PROGRAM LINE 9010": GOSUB 785: GOTO 5040
  425. 10000  REM **DISPLAY DATA SUB MENU**
  426. 10010 V1 = 5:B$ = "                               ": REM    30 SPACES
  427. 10020 BC$ =  CHR$(2):D$ =  CHR$(4):G$ =  CHR$(7):H$ =  CHR$(8):V1$ =  CHR$(91):V2$ =  CHR$(93)
  428. 10030  TEXT : HOME : GOSUB 305
  429. 10040 AA$ = "     DISPLAY  DATA     ":A1$ = "         MENU          ": GOSUB 260
  430. 10050 M$(1) = "DISPLAY/PRINT FOOD DATA":M$(2) = "SEARCH FOODS BY KEY WORDS":M$(3) = "SORT FOODS-PRINT LIST":M$(4) = "FOOD NUTRITION EVALUATION":M$(5) = "RETURN TO MAIN MENU"
  431. 10060  FOR K = 1 TO V1: VTAB (2 *K +3): HTAB 8: PRINT K;". ";M$(K): NEXT K
  432. 10070  VTAB 22: HTAB 4: PRINT "ENTER CHOICE (BY NUMBER): ";G$;V1$;" ";V2$;H$;H$;: NORMAL : GET Y$: PRINT Y$:Y =  VAL(Y$): IF Y <1  OR Y >V1  THEN 10070
  433. 10080  VTAB 2 *Y +3: HTAB 8: INVERSE : PRINT Y;". ";M$(Y): NORMAL : FOR KK = 1 TO 400: NEXT KK
  434. 10090  IF Y = V1  THEN  CLEAR : GOTO 1500
  435. 10100 SX =  PEEK(768):DX =  PEEK(769)
  436. 10110  ON Y GOTO 10500,11000,12000,12500,1500
  437. 10500  REM **DISPLAY/PRINT DATA**
  438. 10510 A1$ = "DISPLAY/PRINT DATA"
  439. 10520  TEXT : HOME : GOSUB 260: HOME :FILE$ = "FOOD": GOSUB 320:RX = 0: GOSUB 275
  440. 10530  INPUT REC
  441. 10540  PRINT D$"CLOSE";FILE$
  442. 10550  HOME : VTAB 6: PRINT "ENTER IN PRINTER INFORMATION.": PRINT : PRINT "DO YOU WANT A PRINTOUT (Y/N) ";G$;: GET Y$: PRINT Y$: IF Y$ = "N"  THEN SLOT = 0: GOTO 10640
  443. 10560  IF Y$ < >"Y"  THEN 10550
  444. 10570  VTAB 10: CALL  -868: PRINT "ENTER IN SLOT # ";G$;: GET SL$: PRINT SL$:SLOT =  VAL(SL$)
  445. 10580  IF Y$ =  CHR$(27)  OR Y$ =  CHR$(32)  THEN  CLEAR : GOTO 1500
  446. 10590  IF SLOT <1  OR SLOT >7  THEN  PRINT G$;G$: GOTO 10570
  447. 10600  PRINT : PRINT "PLEASE TURN ON PRINTER.": PRINT "PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " WHEN READY. ";G$;: INPUT Y$
  448. 10610  PRINT D$"PR#";SLOT
  449. 10620  PRINT 
  450. 10630  PRINT D$"PR#0"
  451. 10640  HOME : VTAB 22: HTAB 10: GOSUB 250: VTAB 7: PRINT 
  452. 10650  PRINT "VIEW(V) OR PRINT(P) DATA  ";G$;: GET VP$: PRINT VP$: IF VP$ =  CHR$(13)  THEN  CLEAR : GOTO 1500
  453. 10660  PRINT : CALL  -958: PRINT "ENTER RECORD # TO START WITH ";G$;: INPUT START$:RX =  VAL(START$)
  454. 10670  IF RX >REC  THEN  PRINT "ONLY ";REC;" RECORDS ON FILE!";G$;G$: GOTO 10660
  455. 10680  IF RX <1  THEN RX = 1
  456. 10690  GOSUB 275
  457. 10700  FOR K = 1 TO NF: INPUT P$(K): NEXT K
  458. 10710  IF VP$ = "P"  THEN  PRINT D$"PR#";SLOT: PRINT : PRINT "RECORD # ";RX
  459. 10720  GOSUB 295
  460. 10730  PRINT D$"PR#0"
  461. 10740  PRINT D$"CLOSE";FILE$
  462. 10750  VTAB 22: INVERSE : PRINT "-->";: NORMAL : PRINT " = NEXT   ";: INVERSE : PRINT "<--";: NORMAL : PRINT " = LAST"; TAB( 31);"RECORD #"
  463. 10760  VTAB 23: PRINT "PRESS ";: INVERSE : PRINT "ESC";: NORMAL : PRINT " FOR RECORD # "; TAB( 30);RX;" OF ";REC
  464. 10770  GOSUB 250: PRINT G$;: CALL  -868: GET Y$: PRINT Y$: IF Y$ =  CHR$(3)  THEN  END 
  465. 10780  IF Y$ =  CHR$(27)  THEN  VTAB 24: CALL  -868: PRINT "ENTER RECORD NUMBER ";G$;: INPUT RX: GOTO 10670
  466. 10790  IF Y$ =  CHR$(8)  THEN RX = RX -2: GOTO 10830
  467. 10800  IF Y$ =  CHR$(13)  THEN 10640
  468. 10810  IF Y$ =  CHR$(21)  OR Y$ =  CHR$(32)  THEN 10830
  469. 10820  GOTO 10750
  470. 10830 RX = RX +1: GOTO 10670
  471. 11000  REM **SEARCH FOR FOOD DATA** 
  472. 11010 A1$ = "SEARCH/DISPLAY FOOD DATA"
  473. 11020  TEXT : HOME : GOSUB 260: HOME :FILE$ = "FOOD": GOSUB 320:RX = 0: GOSUB 275
  474. 11030  INPUT REC
  475. 11040  PRINT D$"CLOSE";FILE$
  476. 11050  DIM SRT$(REC +1),SO%(REC)
  477. 11060  PRINT D$"OPEN"FILE$",L";RL;",S";SX;",D";DX
  478. 11070  FOR K = 1 TO REC:RX = K: GOSUB 285: INPUT SRT$(K):SO%(K) = K: NEXT K
  479. 11080  PRINT D$"CLOSE"FILE$
  480. 11090  TEXT : HOME : GOSUB 305: VTAB 12: HTAB 4: PRINT "DO YOU WANT A FOOD LIST ? (Y/N) ": VTAB 14: HTAB 4: PRINT "CONTROL LISTING WITH PADDLE 1": VTAB 16: HTAB 20: INPUT Y$: IF Y$ = "N"  THEN 11150
  481. 11100  IF Y$ < >"Y"  AND Y$ < >"N"  THEN 11090
  482. 11110  TEXT : HOME 
  483. 11120  FOR J = 1 TO ((REC +2)/2)  STEP 2: SPEED=  PDL(1): PRINT SRT$(J); TAB( 20);SRT$(J +1): NEXT J
  484. 11130  SPEED= 255
  485. 11140  PRINT : GOSUB 785: GOTO 11090
  486. 11150  REM CONTINUE
  487. 11160  TEXT : HOME : VTAB 11: HTAB 10: INPUT "FOOD KEY WORD ? ";Z$:L =  LEN(Z$): IF L >20  THEN  VTAB 13: HTAB 05: PRINT "LESS THAN 20 CHARACTERS PLEASE": FOR J = 1 TO 1000: NEXT J: GOTO 11160
  488. 11170  VTAB 1: HTAB 16: FLASH : PRINT "SEARCHING": POKE 34,3: NORMAL : HOME 
  489. 11180  FOR J = 1 TO REC
  490. 11190 LS =  LEN(SRT$(J))
  491. 11200  IF LS <L  THEN 11240
  492. 11210  FOR I = 1 TO (LS -L +1):Y$ =  MID$ (SRT$(J),I,L): IF Y$ < >Z$  THEN 11230
  493. 11220  PRINT  TAB( 6);SO%(J); TAB( 10);SRT$(J)
  494. 11230  NEXT I
  495. 11240  NEXT J
  496. 11250  VTAB 23: HTAB 6: PRINT "ANOTHER SEARCH ? (Y/N) ";: GET Y$: IF Y$ = "Y"  THEN 11160
  497. 11260  IF Y$ = "N"  THEN  CLEAR : GOTO 1500
  498. 11270  GOTO 11250
  499. 12000  TEXT : REM **PRINT USER FOOD LIST**
  500. 12010  HOME : INVERSE : VTAB 10: PRINT "LOADING 'SORT AND PRINT FOOD LIST'": NORMAL 
  501. 12020  PRINT D$;"RUN SORT AND PRINT FOOD LIST,S6,D1"
  502. 12500  REM ** PERCENT DAILY NEEDS**
  503. 12510  POKE 34,0: GOSUB 715: GOSUB 835:FILE$ = "FOOD": GOSUB 850
  504. 12520  TEXT : HOME : VTAB 8: PRINT "I WILL ASK YOU FOR THE RECORD NUMBER": VTAB 10: PRINT "OF THE FOOD YOU WANT TO REVIEW AND": VTAB 12: PRINT "THEN TELL YOU THE PERCENTAGE OF YOUR": VTAB 14: PRINT "DAILY REQUIREMENTS MET BY THE SERVING"
  505. 12530  VTAB 16: PRINT "YOU CHOOSE": GOSUB 680:CI = CC: DIM NU(NF)
  506. 12540  FOR K = 4 TO NF: READ PS$(K): NEXT : GOSUB 785
  507. 12550  DATA   "CALORIES","PROTEIN","FAT" ,"CARBOHYDRATE", "CALCIUM", "IRON", "SODIUM", "VITAMIN A", "THIAMINE", "RIBOFLAVIN", "NIACIN", "VITAMIN C", "CHOLESTEROL" 
  508. 12560  HOME : VTAB 20: PRINT G$;G$: VTAB 20: HTAB 9: INPUT "RECORD NUMBER OF FOOD ? ";A$: VTAB 20: HTAB 34
  509. 12570 RX =  VAL(A$): IF ((RX <1)  OR (RX >REC))  THEN  HOME : VTAB 16: INVERSE : HTAB 5: PRINT "ONLY ";REC;" RECORDS ON THE FOOD FILES": NORMAL : FOR K = 1 TO 2000: NEXT K: GOTO 12560
  510. 12580  GOSUB 865: FOR K = 4 TO NF:P(K) =  VAL(P$(K)):PS(K) = P(K) *CO: NEXT K
  511. 12590  GOSUB 905
  512. 12600  IF ER = 1  THEN A$ = A$ +" * " +P$(1)
  513. 12610  VTAB 20: HTAB 10: PRINT P$(1): VTAB 21: HTAB 10: PRINT A$
  514. 12620  GOSUB 785
  515. 12630  TEXT : HOME : VTAB 10: HTAB 7:QQ$ = "EVALUATE ANOTHER FOOD ? ": GOSUB 505: IF YES  THEN  HOME : GOTO 12560
  516. 12640  HOME : CLEAR : GOTO 1500
  517. 13000  REM **RECIPE EVALUATION**
  518. 13010  TEXT : HOME : VTAB 5: PRINT "THIS SECTION OF THE PROGRAM ALLOWS": VTAB 7: PRINT "YOU TO ESTABLISH THE NUTRITIONAL": VTAB 9: PRINT "CONTENT OF YOUR FAVORITE RECIPES.": VTAB 11: PRINT "THE DATA IS THEN STORED ON THE DISK"
  519. 13020  VTAB 13: PRINT "AS A SINGLE FOOD ITEM FOR FUTURE USE": VTAB 15: PRINT "IN YOUR NUTRITION ANALYSIS."
  520. 13030  VTAB 18: PRINT "THE FOODS USED IN THE RECIPE MUST BE": VTAB 20: PRINT "AVAILABLE IN THE FOOD LIST.": GOSUB 785
  521. 13040  HOME : GOSUB 985: VTAB 8: PRINT "I WILL BEGIN BY ASKING YOU TO PROVIDE": VTAB 10: PRINT "ME WITH THE RECORD NUMBERS AND": VTAB 12: PRINT "QUANTITIES OF FOODS IN THE RECIPE.": GOSUB 785
  522. 13050  DIM PS(NF),P(NF),PS$(20),CS$(20): FOR K = 1 TO NF:PS(K) = 0:P(K) = 0: NEXT K:NI = 0:WA = 0
  523. 13060  GOSUB 930
  524. 13070  IF  LEN(A$) = 0  THEN 13140
  525. 13080  IF ER  THEN  PRINT : CALL  -958: PRINT G$;"ENTER NUMBERS ONLY.": PRINT "PLEASE RE-ENTER FOOD NUMBER.": GOSUB 785:NI = NI -1: GOTO 13060
  526. 13085  IF CO = 0  THEN NI = NI -1: GOTO 13060
  527. 13090 WA = WA +CO *100
  528. 13100  GOSUB 960
  529. 13110  IF NI = 20  THEN  GOSUB 975: VTAB 10: PRINT "PLEASE STORE THIS MUCH AS A SINGLE": VTAB 12: PRINT "SERVING AND INCLUDE IT AS A DUMMY": VTAB 14: PRINT "ENTRY IN ANOTHER SESSION TO COMPLETE": VTAB 16: PRINT "THIS RECIPE"
  530. 13120  IF NI = 20  THEN  VTAB 19: PRINT "YOU SHOULD THEN DELETE THIS ENTRY": VTAB 21: PRINT "FROM THE FOOD LIST": GOSUB 785
  531. 13130  IF NI <20  THEN 13060
  532. 13140  TEXT : HOME :AA$ = "   LIST OF FOODS   ":A1$ = "  IN THIS RECIPE   ": GOSUB 260: GOSUB 520: IF YES  THEN 13150
  533. 13145  HOME : CLEAR : GOTO 1500
  534. 13150  TEXT : HOME : VTAB 4: PRINT "I HAVE ESTABLISHED THE TOTAL WEIGHT OF": VTAB 6: PRINT "THE RECIPE AS "; INT(WA);" GM OR "; INT(WA/2.83)/10;" OZ"
  535. 13160  VTAB 9: PRINT "PLEASE PROVIDE THE REVISED OR COOKED": VTAB 11: PRINT "TOTAL WEIGHT IF YOU DESIRE GREATER": VTAB 13: PRINT "ACCURACY."
  536. 13170  VTAB 23: PRINT "PRESS ";: FLASH : PRINT "RETURN";: NORMAL : PRINT " IF NO CHANGE"
  537. 13190  VTAB 20: INPUT "TOTAL WEIGHT (XXGM OR XXOZ) ";A$
  538. 13200  IF  LEN(A$) = 0  THEN 13270
  539. 13210  IF ( RIGHT$(A$,2) = "GM")  OR ( RIGHT$(A$,2) = "OZ")  THEN 13230
  540. 13220  VTAB 20: PRINT "MUST END IN 'GM' OR 'OZ'!          ": FOR K = 1 TO 1500: NEXT K: GOTO 13190
  541. 13230 LE =  LEN(A$): GOSUB 475
  542. 13240 A$ =  LEFT$(A$,LE -2)
  543. 13250 WA =  VAL(A$): IF WA = 0  THEN  HOME : VTAB 2: PRINT "REVISED WEIGHT MUST BE A NUMBER": GOTO 13160
  544. 13260 WA = 100 *CO
  545. 13270  HOME : VTAB 2: PRINT "PLEASE ENTER THE RECIPE NAME AS 'FOOD'":K = 1: PRINT : PRINT : GOSUB 215
  546. 13280  IF  LEN(P$(1)) >TV(1)  THEN  PRINT "ENTRY TOO LONG";G$;G$: FOR KK = 1 TO 750: NEXT KK: VTAB (CV +1): HTAB 1: CALL  -958: GOTO 13270
  547. 13290  TEXT : HOME : VTAB 8: PRINT "PLEASE TELL ME THE NUMBER OF STANDARD ": VTAB 10: PRINT "SERVINGS IN THE RECIPE": VTAB 13: HTAB 8: INPUT "SERVINGS ?";KK: IF KK < = 0  THEN 13290
  548. 13300 P$(2) =  STR$( INT(WA/KK)) +"GM-" + STR$( INT(WA/(KK *2.83))/10) +"OZ-1/" + STR$(KK) +"SUM": IF  LEN(P$(2)) >20  THEN  HOME : VTAB 10: PRINT "SECOND FIELD TOO LONG": FOR K = 1 TO 3000: NEXT K: GOTO 13290
  549. 13310 P$(3) =  STR$((WA/(KK *100))): FOR K = 4 TO NF:P$(K) =  STR$((100/WA) *PS(K)):P$(K) =  LEFT$(P$(K),6): NEXT K
  550. 13320  GOSUB 1005:RX = 0: GOSUB 230: PRINT REC: PRINT D$"CLOSE": HOME : VTAB 10: PRINT P$(1);" STORED AS RECORD ";REC: FOR K = 1 TO 2000: NEXT K: CLEAR : GOTO 1500
  551. 14000  REM **TO BE ASSIGNED**
  552. 14010  TEXT : HOME : VTAB 10: PRINT "TO BE ASSIGNED AT PROGRAM LINE 14010": GOSUB 785: GOTO 1550
  553. 25000  REM **END PROGRAM ROUTINE**
  554. 25010  FOR K = 1 TO 100: NEXT K: TEXT : HOME : PRINT "DON'T FORGET TO MAKE A BACK-UP": PRINT "OF YOUR DATA.";G$;G$;G$: PRINT : PRINT "HAVE A NICE DAY!"